Force data from Expert and Novice surgeons; data extracted from 17 procedures involving Glioma tumor (multiple tasks per procedure) and segmented for each microsurgical task.

This document contains the data management and analytic framework for SmartForceps, a sensorized surgical bipolar forceps capable of quantifying the forces of tool-tissue interaction in microsurgery. We have shown that high force error is associated with bleeding, low force error with the need to repeat the task and force variability with both. We have further established that novice and intermediate level surgeons exert more force errors compared to experienced. The technology introduces a data-driven surgical paradigm whereby forces of tool-tissue interaction are used as an objective assessment metric for surgical competency. Together with the error warning system, the reduction of surgical error and improved patient safety is promised.

The present document incorporates 17 cases of neurosurgery performed at Foothills Medical Centre, Calgary. The data were extracted and segmented for each task of microsurgery performed by an Expert and multiple Novice surgeons.

The multimedia supplementary files for the software and device structure is available at https://github.com/smartforceps/supplementary/.

The reader can show any code chunk by clicking on the code button. We chose to make the default for the code hidden since we: (a) wanted to improve the readability of this document; and (b) assumed that the readers will not be interested in reading every code chunk.


The snippet below documents the list of R libraries that were used in this research. For convenience, we used the pacman package since it allows for installing/loading the needed libraries in one step.

rm(list = ls()) # clear global environment
graphics.off() # close all graphics
library(pacman) # needs to be installed first
p_load(
  pastecs,
  reticulate,
  readr,
  htmltools,
  vembedr,
  devtools,
  usethis,
  slam,
  reshape2,
  data.table,
  gridExtra,
  extrafont,
  ISLR,
  jpeg,
  coda,
  abind,
  chron,
  fmsb,
  gdata,
  stringr,
  lubridate,
  ggplot2,
  ggpubr,
  gghighlight,
  ggridges,
  plotly,
  tidyverse,
  fBasics,
  signal,
  GeneCycle,
  Rwave,
  seewave,
  spectral,
  tsfeatures,
  peakPick,
  pracma,
  foreach,
  glue,
  dplyr,
  rstatix,
  emmeans,
  EnvStats,
  kableExtra
  )

Data Recording

Data is generated through strain gauge sensors placed along the prongs of a bipolar forceps. The technology is designed and manufactured within OrbSurgical, ltd. in partnership with Bissinger, Germany. The calibrated data is analyzed and recorded in realtime through our software platform which is overviewed in the snippet below. Please navigate through different items in the tabs for various pages in the software.

SmartForceps Software

Home Page

Adding New Case

Download Forceps and Hospital Data Page

Data Monitoring Page

Data Upload Page

Software Demo

Below is a short demo of our software showing the force profiles in realtime with a high force error warning system (with 0.8 N threshold) and a voice recognition module to identify the keywords for different surgical tasks.

Orbsurgical SmartForceps Web Application

SmartForceps comes with a web application to manage the data, device characteristics (e.g. calibration factors), and medical center and surgeon information. This platform is designed in a way to manage the data to and from the cloud through integration into the software.

Data Processing

Data was extracted and analyzed using R programming platform. In the snippet below, we import the “.txt” files obtained from our Azure data cloud and the “.xlsx” file containing each task information (e.g. time stamp, task name, surgeon name, and remarks of potential intraoperative force errors) extracted from the surgical team voice recorded during each case. The imported data are structured as R dataframes.

We have extracted various features from the segmented task force data in each prong. A combination of average, minimum, or maximum value of features for each prongs were included in the future analysis. These time-series features included:

  1. Force Duration: duration of force application in one task segment.

  2. Force Average: average of force values in one task segment.

  3. Force Max: maximum of force values in one task segment.

  4. Force Min: minimum of force values in one task segment.

  5. Force Range: range of force values in one task segment.

  6. Force Median: median of force values in one task segment.

  7. Force SD: standard deviation of force values in one task segment.

  8. Force CV: coefficient of variation of force values in one task segment.

  9. Force Peak Value: peak force value in one task segment.

  10. Force Peak Counts: number of force peaks in one task segment.

  11. Force Signal Flat Spots: maximum run length for each section of force time-series when divided into ten equal-sized intervals.

  12. Force Signal Trend: force time-series trend in one task segment.

  13. Force Signal Fluctuations: force time-series fluctuation index in one task segment.

  14. Force Signal Spikiness: force time series spikiness index (variance of the leave-one-out variances of the remainder component) in one task segment.

  15. Force Signal Stability: force time-series stability index (variance of the means) in one task segment.

  16. Force Signal Entropy: force time-series forecastability in one task segment (low values indicate a high signal-to-noise ratio).

Among these feature list, the best subset will be selected for the subsequent analysis based on statistical tests to monitor their representation power in different surgeon skill and task categories. The aim was to have the best explain of the patterns and behaviors for force profiles over the timespan of each data segment. To find accurate force peaks within each task segment, the signals were smoothed by passing through a digital 4st order Butterworth low-pass filter with a cutoff frequency of 0.1 Hz. Further, the outlier segmented data were identified based on 1st and 99th percentiles of either maximum force, minimum force or task completion time from all trials of the expert surgeon as <1% error was assumed to occur by experienced surgeons. The force segments for which the maximum force peak, minimum force valley, or task completion time exceeded the upper threshold (99th percentile) or fell short of the lower threshold (1st percentile) were labeled as outliers and removed (~11% were removed). The clean engineered features serve as a baseline for hand-crafted feature-based surgical skill classification.

The surgical tasks were classified as 5 main categories:

  1. Retracting

  2. Manipulation

  3. Dissecting

  4. Pulling

  5. Coagulation

# defining functions
absmax <- function(x) { x[which.max( abs(x) )]}

# reading data
data_info <- read.xls ("~/Desktop/Canada/neuroArm/SmartForceps/Glioma/codes/Glioma Data Info - Subtask.xlsx", 
                       sheet = 1, header = TRUE)
data_dir <- "~/Desktop/Canada/neuroArm/SmartForceps/SmartForceps Data"
cases <- c(5, 6, 7, 10, 15, 16, 22, 37, 42, 48, 53, 54, 56, 66, 77, 91) # Glioma Cases


# "SF-3":       2:23            (3.46, 3.90)
# "SF1-2020"    24:45, 47:51    (3.45, 3.45)
# "SF3-2020-S"  46              (3.90, 3.90)

forceps_names <- c(rep("SF-3", 22), rep("SF1-2020", 67), rep("SF3-2020-S", 1))
forceps_cases <- vector(mode="list", length=90)
names(forceps_cases) <- c(as.character(c(2:23)), as.character(c(24:45, 47:91)), as.character(46))
for (i in 1:length(forceps_cases)) {
  forceps_cases[[i]] <- forceps_names[i]
}


calibrtion_factors <- list("SF-3" = c(3.46, 3.90),
                           "SF1-2020" = c(3.45, 3.45),
                           "SF3-2020-S" = c(4.43, 4.43))

# preparing each case data
for (i in cases) {
  file_dir <- paste(c(data_dir, paste(c("Case", i), collapse = " "), "log data"), collapse ="/")
  temp <- list.files(path = file_dir, pattern = "*.txt")
  my_data <- data.frame()
  for (j in 1:length(temp)) {
    read_txt <- read.delim(paste(c(file_dir, temp[j]), collapse = "/"))
    my_data <- rbind(my_data,
                     cbind(data.frame(DataSection = rep(j, dim(read_txt)[1])),
                           read_txt))
    
    # apply calibration factors
    my_data$LeftCalibratedForceValue <- 
      my_data$LeftRawVoltageValue*calibrtion_factors[[forceps_cases[[as.character(i)]]]]
    my_data$RightCalibratedForceValue <- 
      my_data$RightRawVoltageValue*calibrtion_factors[[forceps_cases[[as.character(i)]]]]

    assign(paste0("case_", i, "_forcedata"), my_data)
  }
}

# concatenating case data
force_seg_data <- data.frame()
force_seg_info <- data.frame()
task_count <- c(0,0,0,0,0,0,0,0,0,0,0,0,0)
outlier_count <- 0
seg_num_res <- 0
acqFreq <- 20
for (i in 1:length(cases)) {
  #print("Case:")
  #print(cases[i])
  case_i_info <- data_info[data_info[, "Case"] == cases[i],]
  case_i_data <- get(paste(c("case", cases[i], "forcedata"), collapse = "_"))
  
  case_i_secpowerupstartidxs <- c(1, which(diff(case_i_data$DataSection) != 0) + 1)
  case_i_secpoweruptimes <- case_i_data$MillisecondsSincePowerUp[case_i_secpowerupstartidxs]
  
  for (j in 1:dim(case_i_info)[1]) {
    data_section <-
      as.numeric(strsplit(toString(case_i_info$Remarks[j]), split = " ")[[1]][2])
    if(is.na(strsplit(toString(case_i_info$Remarks[j]), split = " ")[[1]][5])){
      surgeon_experience <- "Expert"
    } else {
      surgeon_experience <- "Novice"
    }
    if(size(strsplit(toString(case_i_info$Remarks[j]), split = " ")[[1]])[2] > 2){
      surgeon_name <- tail(strsplit(toString(case_i_info$Remarks[j]), split = " ")[[1]], n=1)
    } else {
      surgeon_name <- "Dr. Sutherland"
    }
    
    task_type <-
      strsplit(str_sub(case_i_info$Task[j]), split = " ")[[1]][1]
    if (task_type == "Coagulation"){
      task_type <- str_sub(case_i_info$Task[j])
    }
    t_start <-
      as.numeric(seconds(hms(case_i_info$TimeStart[j]))) * 1000 + case_i_secpoweruptimes[data_section]
    t_end <-
      as.numeric(seconds(hms(case_i_info$TimeEnd[j]))) * 1000 + case_i_secpoweruptimes[data_section]
    idx_start <-
      as.numeric(rownames(case_i_data[case_i_data[, "MillisecondsSincePowerUp"] == t_start, ]))
    idx_end <-
      as.numeric(rownames(case_i_data[case_i_data[, "MillisecondsSincePowerUp"] == t_end, ]))
    
    # LeftCalibratedForce <- case_i_data[idx_start:idx_end, "LeftCalibratedForceValue"]
    # RightCalibratedForce <- case_i_data[idx_start:idx_end, "RightCalibratedForceValue"]
    TimeS <- seq(0, length(idx_end:idx_start)*0.05-0.05, by=0.05)
    
    # handle each task accordingly
    if (strsplit(str_sub(case_i_info$Task[j]), split = " ")[[1]][1] == "Coagulation"){
      # only positive values are expected 
      LeftCalibratedForce <- case_i_data[idx_start:idx_end, "LeftCalibratedForceValue"] - 
        min(case_i_data[idx_start:idx_end, "LeftCalibratedForceValue"])
      RightCalibratedForce <- case_i_data[idx_start:idx_end, "RightCalibratedForceValue"] - 
        min(case_i_data[idx_start:idx_end, "RightCalibratedForceValue"])
      
    } else if (strsplit(str_sub(case_i_info$Task[j]), split = " ")[[1]][1] == "Dissecting"){
      # only negative values are expected (returned to positive)
      LeftCalibratedForce <- abs(case_i_data[idx_start:idx_end, "LeftCalibratedForceValue"] - 
        max(case_i_data[idx_start:idx_end, "LeftCalibratedForceValue"]))
      RightCalibratedForce <- abs(case_i_data[idx_start:idx_end, "RightCalibratedForceValue"] - 
        max(case_i_data[idx_start:idx_end, "RightCalibratedForceValue"]))

    } else {
      LeftCalibratedForce <- case_i_data[idx_start:idx_end, "LeftCalibratedForceValue"]
      RightCalibratedForce <- case_i_data[idx_start:idx_end, "RightCalibratedForceValue"]
    } 
    
    
    if (task_type == "Coagulation"){
      task_count[1] = task_count[1]+1
      seg_num_task = task_count[1]
    } else if (task_type == "Coagulation (Vessel)"){
      task_count[2] = task_count[2]+1
      seg_num_task = task_count[2]
    } else if (task_type == "Coagulation (Galea)"){
      task_count[3] = task_count[3]+1
      seg_num_task = task_count[3]
    } else if (task_type == "Coagulation (Dura)"){
      task_count[4] = task_count[4]+1
      seg_num_task = task_count[4]
    } else if (task_type == "Coagulation (Muscle)"){
      task_count[5] = task_count[5]+1
      seg_num_task = task_count[5]
    } else if (task_type == "Coagulation (Pia / Arachnoid)"){
      task_count[6] = task_count[6]+1
      seg_num_task = task_count[6]
    } else if (task_type == "Coagulation (Tumor)"){
      task_count[7] = task_count[7]+1
      seg_num_task = task_count[7]
    } else if (task_type == "Coagulation (Brain)"){
      task_count[8] = task_count[8]+1
      seg_num_task = task_count[8]
    } else if (task_type == "Coagulation (Gliotic / Scar Tissue)"){
      task_count[9] = task_count[9]+1
      seg_num_task = task_count[9]
    } else if (task_type == "Pulling"){
      task_count[10] = task_count[10]+1
      seg_num_task = task_count[10]
    } else if (task_type == "Manipulation"){
      task_count[11] = task_count[11]+1
      seg_num_task = task_count[11]
    } else if (task_type == "Dissecting"){
      task_count[12] = task_count[12]+1
      seg_num_task = task_count[12]
    } else if (task_type == "Retracting"){
      task_count[13] = task_count[13]+1
      seg_num_task = task_count[13]
    } 
    
  
    # segment data
    force_seg_data <- rbind(
    force_seg_data,
    data.frame(
    "CaseNum" = rep(cases[i], length(idx_end:idx_start)),
    "SegmentNum" = rep(j, length(idx_end:idx_start)),
    "SegmentNumTask" = rep(seg_num_task, length(idx_end:idx_start)),
    "SegmentNumOverall" = rep(seg_num_res+j, length(idx_end:idx_start)),
    "Time" = TimeS,
    "LeftForce" = LeftCalibratedForce,
    "RightForce" = RightCalibratedForce,
    "TaskType" = rep(task_type, length(idx_end:idx_start))
    ))
    
    desc_stats_left <- stat.desc(LeftCalibratedForce, norm=TRUE)
    desc_stats_right <- stat.desc(RightCalibratedForce, norm=TRUE)

    forceDetrendLeft <- as.numeric(lm(LeftCalibratedForce ~TimeS)$residuals)
    forceDetrendRight <- as.numeric(lm(RightCalibratedForce ~TimeS)$residuals)
    # the first 10 harmonics of the signal
    forceFreqLeft <- order(-Mod(fft(forceDetrendLeft))[1:(acqFreq/2)])-1
    forceFreqRight <- order(-Mod(fft(forceDetrendRight))[1:(acqFreq/2)])-1
    # converting signal to time series
    tsForceLeft <- ts(LeftCalibratedForce, frequency = forceFreqLeft[1])
    tsForceRight <- ts(RightCalibratedForce, frequency = forceFreqRight[1])
    # extracting time series features
    tsFeaturesLeft <- tsfeatures(LeftCalibratedForce)
    tsFeaturesRight <- tsfeatures(RightCalibratedForce)

    # filter force profiles to find peaks
    bf <- butter(4, 0.1, type="low")
    LForceFilt <- signal::filter(bf, LeftCalibratedForce)
    # plot(LeftCalibratedForce, type = "l")
    # lines(LForceFilt, col = "red")
    peakhits <- peakpick(matrix(LForceFilt, ncol=1), neighlim=5, peak.min.sd=5, peak.npos=20)
    # peaks from mean
    forcePeaksLeft <- LForceFilt[peakhits] - mean(LForceFilt)
    if (length(forcePeaksLeft) == 0) {
      forcePeaksLeft <- NA
    }
    # forcePeaksLeft <- findpeaks(as.numeric(LForceFilt), minpeakdistance = 5)
    # plot(LForceFilt)
    # points((1:length(LForceFilt))[peakhits], LForceFilt[peakhits], col="red")

    RForceFilt <- signal::filter(bf, RightCalibratedForce)
    #plot(RightCalibratedForce, type = "l")
    #lines(RForceFilt, col = "red")
    peakhits <- peakpick(matrix(RForceFilt, ncol=1), neighlim=5, peak.min.sd=5, peak.npos=20)
    # peaks from mean
    forcePeaksRight <- RForceFilt[peakhits] - mean(RForceFilt)
    if (length(forcePeaksRight) == 0) {
      forcePeaksRight <- NA
    }
    # forcePeaksRight <- findpeaks(as.numeric(RForceFilt), minpeakdistance = 5)
    # plot(RForceFilt)
    # points((1:length(RForceFilt))[peakhits], RForceFilt[peakhits], col="red")

    # handle no peak instances
    if (is.na(forcePeaksLeft) & is.na(forcePeaksRight)) {
      forcePeaks <- NA
    } else {
      forcePeaks <- max(max(forcePeaksLeft, na.rm = TRUE),
                        max(forcePeaksRight, na.rm = TRUE),
                        na.rm = TRUE)
    }

    # plot.frequency.spectrum <- function(X.k, xlimits=c(0,length(X.k))) {
    #   plot.data  <- cbind(0:(length(X.k)-1), Mod(X.k))
    #
    #   # TODO: why this scaling is necessary?
    #   plot.data[2:length(X.k),2] <- 2*plot.data[2:length(X.k),2]
    #
    #   plot(plot.data, t="h", lwd=2, main="",
    #        xlab="Frequency (Hz)", ylab="Strength",
    #        xlim=xlimits, ylim=c(0,max(Mod(plot.data[,2]))))
    # }

    # segment info
    force_seg_info <- rbind(
    force_seg_info,
    data.frame(
    "CaseNum" = cases[i],
    "SegmentNum" = j,
    "SegmentNumTask" = seg_num_task,
    "SegmentNumOverall" = seg_num_res+j,
    "TaskType" = task_type,
    "User" = surgeon_experience,
    "SurgeonName" = surgeon_name,
    "Duration.Force" = round(length(idx_end:idx_start)*0.05-0.05, digits=4),
    "Mean.Force" = round(mean(desc_stats_left['mean'],
                              desc_stats_right['mean']), digits=4),
    # "Mean.Force" = round(mean(desc_stats_left['range'],
    #                           desc_stats_right['range'])/2, digits=4),
    "Max.Force" = round(max(desc_stats_left['max'],
                            desc_stats_right['max']), digits=4),
    "Min.Force" = round(min(desc_stats_left['min'],
                            desc_stats_right['min']), digits=4),
    "Range.Force" = round(max(desc_stats_left['range'],
                              desc_stats_right['range']), digits=4),
    "Median" = round(median(desc_stats_left['median'],
                            desc_stats_right['median']), digits=4),
    "SD" = round(max(desc_stats_left['std.dev'],
                     desc_stats_right['std.dev']), digits=4),
    "Coef.Variance" = round(max(desc_stats_left['coef.var'],
                                 desc_stats_right['coef.var']), digits=4),
    "Force.Peaks" = round(forcePeaks, digits=4),
    "Peaks.Count" = round(max(length(forcePeaksLeft),
                              length(forcePeaksRight)), digits=4),
    "Flat.Spots" = round(min(flat_spots(LeftCalibratedForce),
                             flat_spots(RightCalibratedForce)), digits=4),
    "Trend" = round(mean(tsFeaturesLeft[['trend']],
                         tsFeaturesRight[['trend']]), digits=4),
    "Fluctuation" = round(absmax(c(fluctanal_prop_r1(LeftCalibratedForce),
                                   fluctanal_prop_r1(RightCalibratedForce))), digits=4),
    "Spike" = round(absmax(c(tsFeaturesLeft[['spike']],
                             tsFeaturesRight[['spike']])), digits=4),
    "Stability" = round(mean(stability(LeftCalibratedForce),
                             stability(RightCalibratedForce)), digits=4),
    "Entropy" = round(max(tsFeaturesLeft[['entropy']],
                          tsFeaturesRight[['entropy']]), digits=4)
    ))


  }
  seg_num_res <- seg_num_res+dim(case_i_info)[1]
}
row.names(force_seg_info) <- 1:dim(force_seg_info)[1]


# filtering the outliers: cutoffValues = [time, max value, min value, task id]
tasks = c("Coagulation", "Coagulation (Vessel)", "Coagulation (Galea)", 
          "Coagulation (Dura)", "Coagulation (Muscle)", "Coagulation (Pia / Arachnoid)", 
          "Coagulation (Tumor)", "Coagulation (Brain)", "Coagulation (Gliotic / Scar Tissue)",
          "Pulling", "Manipulation", "Dissecting", "Retracting") 
features = c("Duration.Force", 
             "Min.Force", 
             "Max.Force")

thresholds_1 <- vector()
thresholds_99 <- vector()
for (i in 1:length(features)) {
  thresholds_tasks_1 <- vector()
  thresholds_tasks_99 <- vector()
  for (k in 1:length(tasks)) {
    
    data <- force_seg_info %>% 
      filter(TaskType == tasks[k],
             User == "Expert")
    data <- data[features[i]]
    
    threshold <- quantile(data[[1]], c(.01, .99))
    thresholds_tasks_1 <- rbind(thresholds_tasks_1, threshold['1%'][[1]])
    thresholds_tasks_99 <- rbind(thresholds_tasks_99, threshold['99%'][[1]])
  }
  thresholds_1 <- cbind(thresholds_1, thresholds_tasks_1)
  thresholds_99 <- cbind(thresholds_99, thresholds_tasks_99)
}

df_thresholds_1 <- data.frame(thresholds_1)
colnames(df_thresholds_1) <- features
rownames(df_thresholds_1) <- tasks
df_thresholds_99 <- data.frame(thresholds_99)
colnames(df_thresholds_99) <- features
rownames(df_thresholds_99) <- tasks



outlier_count <- 0
force_seg_info_outlier_removed <- data.frame()
for (i in 1:nrow(force_seg_info)) {
  segDur <- force_seg_info[i, 'Duration.Force']
  segMin <- force_seg_info[i, 'Min.Force']
  segMax <- force_seg_info[i, 'Max.Force']
  
  if(sum(df_thresholds_99[force_seg_info[i, 'TaskType'], ] < c(segDur, segMin, segMax)) >= 1){
    # print("outlier detected")
    outlier_count <- outlier_count + 1
  } 
  else if (sum(c(segDur, segMin, segMax) < df_thresholds_1[force_seg_info[i, 'TaskType'], ]) >= 1){
    # print("outlier detected")
    outlier_count <- outlier_count + 1
  }
  else {
    force_seg_info_outlier_removed <- rbind(force_seg_info_outlier_removed, force_seg_info[i, ])
  }
}


save(
  case_5_forcedata,
  case_6_forcedata,
  case_7_forcedata,
  case_10_forcedata,
  case_15_forcedata,
  case_16_forcedata,
  case_22_forcedata,
  case_37_forcedata,
  case_42_forcedata,
  case_48_forcedata,
  case_53_forcedata,
  case_54_forcedata,
  case_56_forcedata,
  case_66_forcedata,
  case_77_forcedata,
  case_91_forcedata,
  file = "~/Desktop/Canada/neuroArm/SmartForceps/Glioma/codes/Subtasks Included/SmartForcepsDataRead.RData")

save(
  force_seg_data,
  file = "~/Desktop/Canada/neuroArm/SmartForceps/Glioma/codes/Subtasks Included/SmartForcepsDataProcessed.RData"
)


save(
  force_seg_info,
  file = "~/Desktop/Canada/neuroArm/SmartForceps/Glioma/codes/Subtasks Included/SmartForcepsDataFeature.RData"
)

save(
  force_seg_info_outlier_removed,
  file = "~/Desktop/Canada/neuroArm/SmartForceps/Glioma/codes/Subtasks Included/SmartForcepsDataFeatureClean.RData"
)



df_feature <- melt(data = force_seg_info_outlier_removed, 
                   id.vars = c("CaseNum", 
                               "SegmentNum",
                               "SegmentNumTask",
                               "SegmentNumOverall", 
                               "TaskType", 
                               "User", 
                               "SurgeonName"), 
                   measure.vars = c("Duration.Force", 
                                    "Mean.Force", 
                                    "Max.Force", 
                                    "Min.Force", 
                                    "Range.Force", 
                                    "Median", 
                                    "SD",     
                                    "Coef.Variance", 
                                    "Force.Peaks",
                                    "Peaks.Count",
                                    "Flat.Spots", 
                                    "Trend", 
                                    "Fluctuation", 
                                    "Spike",
                                    "Stability",
                                    "Entropy"), 
                   variable.name = "FeatureName",
                   value.name = "Value")
df_feature <- data.frame(lapply(df_feature, as.character), stringsAsFactors=FALSE)

df_processed <- melt(data = force_seg_data, 
                     id.vars = c("CaseNum", 
                                 "SegmentNum",
                                 "SegmentNumTask",
                                 "SegmentNumOverall", 
                                 "TaskType", 
                                 "Time"), 
                     measure.vars = c("LeftForce", "RightForce"),
                     variable.name = "ProngName",
                     value.name = "Value")

# returnOptions <- function(feature_data){ 
#   features <- feature_data$FeatureName %>% unique(.)
#   foreach(i=features) %do% list('label'=glue('feature: {i}'), 'value'=i)
# }
# 
# default_featureid <- "DurationForce"
# default_feature_input <- df_feature[df_feature$FeatureName==default_featureid, ]
# default_options <- returnOptions(df_feature)

write.csv(df_processed,
          '~/Desktop/Canada/neuroArm/SmartForceps/Glioma/codes/Subtasks Included/SmartForcepsDataProcessed.csv')

write.csv(df_feature,
          '~/Desktop/Canada/neuroArm/SmartForceps/Glioma/codes/Subtasks Included/SmartForcepsDataFeature.csv')

Force Profiles

Below are the interactive figures of the force profiles for all 17 cases categorized in 13 common surgical tasks categories. The graph can highlight the differences in completion time and range of forces across the 13 surgical tasks.

SmartForceps Left and Right prong data output:

Average of Right and Left Prong Force

data_select_task <- force_seg_data[force_seg_data$TaskType == "Coagulation",]
fig_c <- plot_ly()
for (SegNum in 1:max(data_select_task$SegmentNumTask)) {
  data_select_seg <- data_select_task[data_select_task$SegmentNumTask == SegNum, ]
  fig_c <- add_trace(fig_c, 
                     x = data_select_seg$Time, 
                     y = rowMeans(data_select_seg[,c('LeftForce', 'RightForce')], na.rm=TRUE), 
                     type = 'scatter', mode = 'lines',
                     fill = 'tozeroy', fillcolor = data_select_seg$SegmentNumTask,
                     showlegend = F,
                     line = list(width = 0.5))
}

# fig_c <- fig_c %>% layout(xaxis = list(title = 'Time (sec)'),
#                           yaxis = list(title = 'Task E \n Froce (N) \n '))
fig_c <- fig_c %>% layout(xaxis = list(title = 'Time (sec)'),
                          yaxis = list(range = c(-3, 4), title = 'Coagulation \n Froce (N) \n '))

data_select_task <- force_seg_data[force_seg_data$TaskType == "Coagulation (Vessel)",]
fig_cv <- plot_ly()
for (SegNum in 1:max(data_select_task$SegmentNumTask)) {
  data_select_seg <- data_select_task[data_select_task$SegmentNumTask == SegNum, ]
  fig_cv <- add_trace(fig_cv,
                     x = data_select_seg$Time,
                     y = rowMeans(data_select_seg[,c('LeftForce', 'RightForce')], na.rm=TRUE), 
                     type = 'scatter', mode = 'lines',
                     fill = 'tozeroy', fillcolor = data_select_seg$SegmentNumTask,
                     showlegend = F,
                     line = list(width = 0.5))
}

# fig_cv <- fig_cv %>% layout(xaxis = list(title = 'Time (sec)'),
#                           yaxis = list(title = 'Task E \n Froce (N) \n '))
fig_cv <- fig_cv %>% layout(xaxis = list(title = 'Time (sec)'),
                          yaxis = list(range = c(-3, 4), title = 'Coagulation \n (Vessel) \n Froce (N) \n '))

data_select_task <- force_seg_data[force_seg_data$TaskType == "Coagulation (Galea)",]
fig_cg <- plot_ly()
for (SegNum in 1:max(data_select_task$SegmentNumTask)) {
  data_select_seg <- data_select_task[data_select_task$SegmentNumTask == SegNum, ]
  fig_cg <- add_trace(fig_cg,
                     x = data_select_seg$Time,
                     y = rowMeans(data_select_seg[,c('LeftForce', 'RightForce')], na.rm=TRUE), 
                     type = 'scatter', mode = 'lines',
                     fill = 'tozeroy', fillcolor = data_select_seg$SegmentNumTask,
                     showlegend = F,
                     line = list(width = 0.5))
}

# fig_cg <- fig_cg %>% layout(xaxis = list(title = 'Time (sec)'),
#                           yaxis = list(title = 'Task E \n Froce (N) \n '))
fig_cg <- fig_cg %>% layout(xaxis = list(title = 'Time (sec)'),
                          yaxis = list(range = c(-3, 4), title = 'Coagulation \n (Galea) \n Froce (N) \n '))


data_select_task <- force_seg_data[force_seg_data$TaskType == "Coagulation (Muscle)",]
fig_cm <- plot_ly()
for (SegNum in 1:max(data_select_task$SegmentNumTask)) {
  data_select_seg <- data_select_task[data_select_task$SegmentNumTask == SegNum, ]
  fig_cm <- add_trace(fig_cm,
                     x = data_select_seg$Time,
                     y = rowMeans(data_select_seg[,c('LeftForce', 'RightForce')], na.rm=TRUE), 
                     type = 'scatter', mode = 'lines',
                     fill = 'tozeroy', fillcolor = data_select_seg$SegmentNumTask,
                     showlegend = F,
                     line = list(width = 0.5))
}

# fig_cm <- fig_cm %>% layout(xaxis = list(title = 'Time (sec)'),
#                           yaxis = list(title = 'Task E \n Froce (N) \n '))
fig_cm <- fig_cm %>% layout(xaxis = list(title = 'Time (sec)'),
                          yaxis = list(range = c(-3, 4), title = 'Coagulation \n (Muscle) \n Froce (N) \n '))


data_select_task <- force_seg_data[force_seg_data$TaskType == "Coagulation (Dura)",]
fig_cd <- plot_ly()
for (SegNum in 1:max(data_select_task$SegmentNumTask)) {
  data_select_seg <- data_select_task[data_select_task$SegmentNumTask == SegNum, ]
  fig_cd <- add_trace(fig_cd,
                     x = data_select_seg$Time,
                     y = rowMeans(data_select_seg[,c('LeftForce', 'RightForce')], na.rm=TRUE), 
                     type = 'scatter', mode = 'lines',
                     fill = 'tozeroy', fillcolor = data_select_seg$SegmentNumTask,
                     showlegend = F,
                     line = list(width = 0.5))
}

# fig_cd <- fig_cd %>% layout(xaxis = list(title = 'Time (sec)'),
#                           yaxis = list(title = 'Task E \n Froce (N) \n '))
fig_cd <- fig_cd %>% layout(xaxis = list(title = 'Time (sec)'),
                          yaxis = list(range = c(-3, 4), title = 'Coagulation \n (Dura) \n Froce (N) \n '))

data_select_task <- force_seg_data[force_seg_data$TaskType == "Coagulation (Pia / Arachnoid)",]
fig_cpa <- plot_ly()
for (SegNum in 1:max(data_select_task$SegmentNumTask)) {
  data_select_seg <- data_select_task[data_select_task$SegmentNumTask == SegNum, ]
  fig_cpa <- add_trace(fig_cpa,
                     x = data_select_seg$Time,
                     y = rowMeans(data_select_seg[,c('LeftForce', 'RightForce')], na.rm=TRUE), 
                     type = 'scatter', mode = 'lines',
                     fill = 'tozeroy', fillcolor = data_select_seg$SegmentNumTask,
                     showlegend = F,
                     line = list(width = 0.5))
}

# fig_cpa <- fig_cpa %>% layout(xaxis = list(title = 'Time (sec)'),
#                           yaxis = list(title = 'Task E \n Froce (N) \n '))
fig_cpa <- fig_cpa %>% layout(xaxis = list(title = 'Time (sec)'),
                          yaxis = list(range = c(-3, 4), title = 'Coagulation \n (Pia / Arachnoid) \n Froce (N) \n '))

data_select_task <- force_seg_data[force_seg_data$TaskType == "Coagulation (Tumor)",]
fig_ct <- plot_ly()
for (SegNum in 1:max(data_select_task$SegmentNumTask)) {
  data_select_seg <- data_select_task[data_select_task$SegmentNumTask == SegNum, ]
  fig_ct <- add_trace(fig_ct,
                     x = data_select_seg$Time,
                     y = rowMeans(data_select_seg[,c('LeftForce', 'RightForce')], na.rm=TRUE), 
                     type = 'scatter', mode = 'lines',
                     fill = 'tozeroy', fillcolor = data_select_seg$SegmentNumTask,
                     showlegend = F,
                     line = list(width = 0.5))
}

# fig_ct <- fig_ct %>% layout(xaxis = list(title = 'Time (sec)'),
#                           yaxis = list(title = 'Task E \n Froce (N) \n '))
fig_ct <- fig_ct %>% layout(xaxis = list(title = 'Time (sec)'),
                          yaxis = list(range = c(-3, 4), title = 'Coagulation \n (Tumor) \n Froce (N) \n '))


data_select_task <- force_seg_data[force_seg_data$TaskType == "Coagulation (Brain)",]
fig_cb <- plot_ly()
for (SegNum in 1:max(data_select_task$SegmentNumTask)) {
  data_select_seg <- data_select_task[data_select_task$SegmentNumTask == SegNum, ]
  fig_cb <- add_trace(fig_cb,
                     x = data_select_seg$Time,
                     y = rowMeans(data_select_seg[,c('LeftForce', 'RightForce')], na.rm=TRUE), 
                     type = 'scatter', mode = 'lines',
                     fill = 'tozeroy', fillcolor = data_select_seg$SegmentNumTask,
                     showlegend = F,
                     line = list(width = 0.5))
}

# fig_cb <- fig_cb %>% layout(xaxis = list(title = 'Time (sec)'),
#                           yaxis = list(title = 'Task E \n Froce (N) \n '))
fig_cb <- fig_cb %>% layout(xaxis = list(title = 'Time (sec)'),
                          yaxis = list(range = c(-3, 4), title = 'Coagulation \n (Brain) \n Froce (N) \n '))


data_select_task <- force_seg_data[force_seg_data$TaskType == "Coagulation (Gliotic / Scar Tissue)",]
fig_cgst <- plot_ly()
for (SegNum in 1:max(data_select_task$SegmentNumTask)) {
  data_select_seg <- data_select_task[data_select_task$SegmentNumTask == SegNum, ]
  fig_cgst <- add_trace(fig_cgst,
                     x = data_select_seg$Time,
                     y = rowMeans(data_select_seg[,c('LeftForce', 'RightForce')], na.rm=TRUE), 
                     type = 'scatter', mode = 'lines',
                     fill = 'tozeroy', fillcolor = data_select_seg$SegmentNumTask,
                     showlegend = F,
                     line = list(width = 0.5))
}

# fig_cgst <- fig_cgst %>% layout(xaxis = list(title = 'Time (sec)'),
#                           yaxis = list(title = 'Task E \n Froce (N) \n '))
fig_cgst <- fig_cgst %>% layout(xaxis = list(title = 'Time (sec)'),
                                yaxis = list(range = c(-3, 4), title = 'Coagulation \n (Gliotic / Scar Tissue) \n Froce (N) \n '))


data_select_task <- force_seg_data[force_seg_data$TaskType == "Pulling",]
fig_p <- plot_ly()
for (SegNum in 1:max(data_select_task$SegmentNumTask)) {
  data_select_seg <- data_select_task[data_select_task$SegmentNumTask == SegNum, ]
  fig_p <- add_trace(fig_p, 
                     x = data_select_seg$Time, 
                     y = rowMeans(data_select_seg[,c('LeftForce', 'RightForce')], na.rm=TRUE), 
                     type = 'scatter', mode = 'lines',
                     fill = 'tozeroy', fillcolor = data_select_seg$SegmentNumTask,
                     showlegend = F,
                     line = list(width = 0.5))
}

# fig_p <- fig_p %>% layout(xaxis = list(title = 'Time (sec)'),
#                           yaxis = list(title = 'Task D \n Froce (N) \n '))
fig_p <- fig_p %>% layout(xaxis = list(title = 'Time (sec)'),
                          yaxis = list(range = c(-3, 4), title = 'Pulling \n Froce (N) \n '))

data_select_task <- force_seg_data[force_seg_data$TaskType == "Manipulation",]
fig_m <- plot_ly()
for (SegNum in 1:max(data_select_task$SegmentNumTask)) {
  data_select_seg <- data_select_task[data_select_task$SegmentNumTask == SegNum, ]
  fig_m <- add_trace(fig_m, 
                     x = data_select_seg$Time, 
                     y = rowMeans(data_select_seg[,c('LeftForce', 'RightForce')], na.rm=TRUE), 
                     type = 'scatter', mode = 'lines',
                     fill = 'tozeroy', fillcolor = data_select_seg$SegmentNumTask,
                     showlegend = F,
                     line = list(width = 0.5))
}

# fig_m <- fig_m %>% layout(xaxis = list(title = 'Time (sec)'),
#                           yaxis = list(title = 'Task B \n Froce (N) \n '))
fig_m <- fig_m %>% layout(xaxis = list(title = 'Time (sec)'),
                          yaxis = list(range = c(-3, 4), title = 'Manipulation \n Froce (N) \n '))

data_select_task <- force_seg_data[force_seg_data$TaskType == "Dissecting",]
fig_d <- plot_ly()
for (SegNum in 1:max(data_select_task$SegmentNumTask)) {
  data_select_seg <- data_select_task[data_select_task$SegmentNumTask == SegNum, ]
  fig_d <- add_trace(fig_d, 
                     x = data_select_seg$Time, 
                     y = rowMeans(data_select_seg[,c('LeftForce', 'RightForce')], na.rm=TRUE), 
                     type = 'scatter', mode = 'lines',
                     fill = 'tozeroy', fillcolor = data_select_seg$SegmentNumTask,
                     showlegend = F,
                     line = list(width = 0.5))
}

# fig_d <- fig_d %>% layout(xaxis = list(title = 'Time (sec)'),
#                           yaxis = list(title = 'Task C \n Froce (N) \n '))
fig_d <- fig_d %>% layout(xaxis = list(title = 'Time (sec)'),
                          yaxis = list(range = c(-3, 4), title = 'Dissecting \n Froce (N) \n '))

data_select_task <- force_seg_data[force_seg_data$TaskType == "Retracting",]
fig_r <- plot_ly()
for (SegNum in 1:max(data_select_task$SegmentNumTask)) {
  data_select_seg <- data_select_task[data_select_task$SegmentNumTask == SegNum, ]
  fig_r <- add_trace(fig_r, 
                   x = data_select_seg$Time, 
                   y = rowMeans(data_select_seg[,c('LeftForce', 'RightForce')], na.rm=TRUE), 
                   type = 'scatter', mode = 'lines',
                   fill = 'tozeroy', fillcolor = data_select_seg$SegmentNumTask,
                   showlegend = F,
                   line = list(width = 0.5))
}

# fig_r <- fig_r %>% layout(xaxis = list(title = 'Time (sec)'),
#                           yaxis = list(title = 'Task A \n Froce (N) \n'))
fig_r <- fig_r %>% layout(xaxis = list(title = 'Time (sec)'),
                          yaxis = list(range = c(-3, 4), title = 'Retracting \n Froce (N) \n '))

figs <- list(fig_r, fig_m, fig_d, fig_p, fig_c, fig_cv, fig_cg, fig_cd, fig_cpa, fig_ct, fig_cb, fig_cgst)


figs <- subplot(fig_r, fig_m, fig_d, fig_p, fig_c, fig_cv, fig_cg, fig_cd, fig_cpa, fig_ct, fig_cb, fig_cgst,
                nrows = length(figs), 
                shareX = TRUE, titleX = TRUE, titleY = TRUE)

figs <- figs %>% layout(title = "Overlaid Force Signals Over Time <br> Based on Common Surgical Task Categories (Average of Right and Left Prongs)")

figs

Force Time-series Features

Below are the interactive figures of the force time-series features extracted from all 17 cases categorized in 13 different tasks. The reader can see the relationship between different skill levels and across different tasks. The interactive figure can show detailed statistical results by mouse hover.

Multiple Time-series Features extracted: Please navigate through the dropdown List.

Force Duration

temp_data <- data.frame("TaskType" = force_seg_info_outlier_removed$TaskType, 
                        "User" = force_seg_info_outlier_removed$User,
                        "DurationForce" = force_seg_info_outlier_removed$Duration.Force)

fig <- temp_data %>%
  plot_ly(type = 'violin')
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Expert'],
    x = ~DurationForce[temp_data$User == 'Expert'],
    orientation = "h",
    legendgroup = 'Expert',
    scalegroup = 'Expert',
    name = 'Expert',
    side = 'positive',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("lightseagreen"),
    marker = list(
      line = list(
        width = 1,
        color = "lightseagreen"
      ),
    symbol = 'line-ns'
    )
  )
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Novice'],
    x = ~DurationForce[temp_data$User == 'Novice'],
    orientation = "h",
    legendgroup = 'Novice',
    scalegroup = 'Novice',
    name = 'Non-Expert',
    side = 'negative',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("mediumpurple"),
    marker = list(
      line = list(
        width = 1,
        color = "mediumpurple"
      ),
    symbol = 'line-ns'
    )
  )

fig <- fig %>%
  layout(
    title = "Distribution Pattern – Duration of Force Application by Tasks",
    xaxis = list(
      title = "Duration (sec)",
      showgrid = T
    ),
    yaxis = list(
      title = "Task Type",
      showgrid = T,
      zeroline = F
    ),
    margin = list(t = 50, b = 10, l = 50, r = 50),
    violingap = 2,
    violingroupgap = 2,
    violinmode = 'overlay'
  )

fig

Force Average

temp_data <- data.frame("TaskType" = force_seg_info_outlier_removed$TaskType, 
                        "User" = force_seg_info_outlier_removed$User,
                        "MeanForce" = force_seg_info_outlier_removed$Mean.Force)

fig <- temp_data %>%
  plot_ly(type = 'violin')
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Expert'],
    x = ~MeanForce[temp_data$User == 'Expert'],
    orientation = "h",
    legendgroup = 'Expert',
    scalegroup = 'Expert',
    name = 'Expert',
    side = 'positive',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("lightseagreen"),
    marker = list(
      line = list(
        width = 1,
        color = "lightseagreen"
      ),
    symbol = 'line-ns'
    )
  )
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Novice'],
    x = ~MeanForce[temp_data$User == 'Novice'],
    orientation = "h",
    legendgroup = 'Novice',
    scalegroup = 'Novice',
    name = 'Non-Expert',
    side = 'negative',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("mediumpurple"),
    marker = list(
      line = list(
        width = 1,
        color = "mediumpurple"
      ),
    symbol = 'line-ns'
    )
  )

fig <- fig %>%
  layout(
    title = "Distribution Pattern – Mean of Force Application by Tasks",
    xaxis = list(
      title = "Force (N)",
      showgrid = T
    ),
    yaxis = list(
      title = "Task Type",
      showgrid = T,
      zeroline = F
    ),
    margin = list(t = 50, b = 10, l = 50, r = 50),
    violingap = 2,
    violingroupgap = 2,
    violinmode = 'overlay'
  )

fig

Force Maximum

temp_data <- data.frame("TaskType" = force_seg_info_outlier_removed$TaskType, 
                        "User" = force_seg_info_outlier_removed$User,
                        "MaxForce" = force_seg_info_outlier_removed$Max.Force)

fig <- temp_data %>%
  plot_ly(type = 'violin')
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Expert'],
    x = ~MaxForce[temp_data$User == 'Expert'],
    orientation = "h",
    legendgroup = 'Expert',
    scalegroup = 'Expert',
    name = 'Expert',
    side = 'positive',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("lightseagreen"),
    marker = list(
      line = list(
        width = 1,
        color = "lightseagreen"
      ),
    symbol = 'line-ns'
    )
  )
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Novice'],
    x = ~MaxForce[temp_data$User == 'Novice'],
    orientation = "h",
    legendgroup = 'Novice',
    scalegroup = 'Novice',
    name = 'Non-Expert',
    side = 'negative',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("mediumpurple"),
    marker = list(
      line = list(
        width = 1,
        color = "mediumpurple"
      ),
    symbol = 'line-ns'
    )
  )

fig <- fig %>%
  layout(
    title = "Distribution Pattern – Maximum of Force Application by Tasks",
    xaxis = list(
      title = "Force (N)",
      showgrid = T
    ),
    yaxis = list(
      title = "Task Type",
      showgrid = T,
      zeroline = F
    ),
    margin = list(t = 50, b = 10, l = 50, r = 50),
    violingap = 2,
    violingroupgap = 2,
    violinmode = 'overlay'
  )

fig

Force Minimum

temp_data <- data.frame("TaskType" = force_seg_info_outlier_removed$TaskType, 
                        "User" = force_seg_info_outlier_removed$User,
                        "MinForce" = force_seg_info_outlier_removed$Min.Force)

fig <- temp_data %>%
  plot_ly(type = 'violin')
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Expert'],
    x = ~MinForce[temp_data$User == 'Expert'],
    orientation = "h",
    legendgroup = 'Expert',
    scalegroup = 'Expert',
    name = 'Expert',
    side = 'positive',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("lightseagreen"),
    marker = list(
      line = list(
        width = 1,
        color = "lightseagreen"
      ),
    symbol = 'line-ns'
    )
  )
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Novice'],
    x = ~MinForce[temp_data$User == 'Novice'],
    orientation = "h",
    legendgroup = 'Novice',
    scalegroup = 'Novice',
    name = 'Non-Expert',
    side = 'negative',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("mediumpurple"),
    marker = list(
      line = list(
        width = 1,
        color = "mediumpurple"
      ),
    symbol = 'line-ns'
    )
  )

fig <- fig %>%
  layout(
    title = "Distribution Pattern – Minimum of Force Application by Tasks",
    xaxis = list(
      title = "Force (N)",
      showgrid = T
    ),
    yaxis = list(
      title = "Task Type",
      showgrid = T,
      zeroline = F
    ),
    margin = list(t = 50, b = 10, l = 50, r = 50),
    violingap = 2,
    violingroupgap = 2,
    violinmode = 'overlay'
  )

fig

Force Median

temp_data <- data.frame("TaskType" = force_seg_info_outlier_removed$TaskType, 
                        "User" = force_seg_info_outlier_removed$User,
                        "Median" = force_seg_info_outlier_removed$Median)

fig <- temp_data %>%
  plot_ly(type = 'violin')
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Expert'],
    x = ~Median[temp_data$User == 'Expert'],
    orientation = "h",
    legendgroup = 'Expert',
    scalegroup = 'Expert',
    name = 'Expert',
    side = 'positive',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("lightseagreen"),
    marker = list(
      line = list(
        width = 1,
        color = "lightseagreen"
      ),
    symbol = 'line-ns'
    )
  )
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Novice'],
    x = ~Median[temp_data$User == 'Novice'],
    orientation = "h",
    legendgroup = 'Novice',
    scalegroup = 'Novice',
    name = 'Non-Expert',
    side = 'negative',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("mediumpurple"),
    marker = list(
      line = list(
        width = 1,
        color = "mediumpurple"
      ),
    symbol = 'line-ns'
    )
  )

fig <- fig %>%
  layout(
    title = "Distribution Pattern – Median of Force Application by Tasks",
    xaxis = list(
      title = "Force (N)",
      showgrid = T
    ),
    yaxis = list(
      title = "Task Type",
      showgrid = T,
      zeroline = F
    ),
    margin = list(t = 50, b = 10, l = 50, r = 50),
    violingap = 2,
    violingroupgap = 2,
    violinmode = 'overlay'
  )

fig

Force Range

temp_data <- data.frame("TaskType" = force_seg_info_outlier_removed$TaskType, 
                        "User" = force_seg_info_outlier_removed$User,
                        "RangeForce" = force_seg_info_outlier_removed$Range.Force)

fig <- temp_data %>%
  plot_ly(type = 'violin')
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Expert'],
    x = ~RangeForce[temp_data$User == 'Expert'],
    orientation = "h",
    legendgroup = 'Expert',
    scalegroup = 'Expert',
    name = 'Expert',
    side = 'positive',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("lightseagreen"),
    marker = list(
      line = list(
        width = 1,
        color = "lightseagreen"
      ),
    symbol = 'line-ns'
    )
  )
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Novice'],
    x = ~RangeForce[temp_data$User == 'Novice'],
    orientation = "h",
    legendgroup = 'Novice',
    scalegroup = 'Novice',
    name = 'Non-Expert',
    side = 'negative',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("mediumpurple"),
    marker = list(
      line = list(
        width = 1,
        color = "mediumpurple"
      ),
    symbol = 'line-ns'
    )
  )

fig <- fig %>%
  layout(
    title = "Distribution Pattern – Range of Force Application by Tasks",
    xaxis = list(
      title = "Force (N)",
      showgrid = T
    ),
    yaxis = list(
      title = "Task Type",
      showgrid = T,
      zeroline = F
    ),
    margin = list(t = 50, b = 10, l = 50, r = 50),
    violingap = 2,
    violingroupgap = 2,
    violinmode = 'overlay'
  )

fig

Force Standard Deviation

temp_data <- data.frame("TaskType" = force_seg_info_outlier_removed$TaskType, 
                        "User" = force_seg_info_outlier_removed$User,
                        "ForceSD" = force_seg_info_outlier_removed$SD)

fig <- temp_data %>%
  plot_ly(type = 'violin')
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Expert'],
    x = ~ForceSD[temp_data$User == 'Expert'],
    orientation = "h",
    legendgroup = 'Expert',
    scalegroup = 'Expert',
    name = 'Expert',
    side = 'positive',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("lightseagreen"),
    marker = list(
      line = list(
        width = 1,
        color = "lightseagreen"
      ),
    symbol = 'line-ns'
    )
  )
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Novice'],
    x = ~ForceSD[temp_data$User == 'Novice'],
    orientation = "h",
    legendgroup = 'Novice',
    scalegroup = 'Novice',
    name = 'Non-Expert',
    side = 'negative',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("mediumpurple"),
    marker = list(
      line = list(
        width = 1,
        color = "mediumpurple"
      ),
    symbol = 'line-ns'
    )
  )

fig <- fig %>%
  layout(
    title = "Distribution Pattern – Standard Deviation in Force Application by Tasks",
    xaxis = list(
      title = "Standard Deviation of Force Profile",
      showgrid = T
    ),
    yaxis = list(
      title = "Task Type",
      showgrid = T,
      zeroline = F
    ),
    margin = list(t = 50, b = 10, l = 50, r = 50),
    violingap = 2,
    violingroupgap = 2,
    violinmode = 'overlay'
  )

fig

Force Peak Values

temp_data <- data.frame("TaskType" = force_seg_info_outlier_removed$TaskType, 
                        "User" = force_seg_info_outlier_removed$User,
                        "ForcePeaks" = force_seg_info_outlier_removed$Force.Peaks)

fig <- temp_data %>%
  plot_ly(type = 'violin')
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Expert'],
    x = ~ForcePeaks[temp_data$User == 'Expert'],
    orientation = "h",
    legendgroup = 'Expert',
    scalegroup = 'Expert',
    name = 'Expert',
    side = 'positive',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("lightseagreen"),
    marker = list(
      line = list(
        width = 1,
        color = "lightseagreen"
      ),
    symbol = 'line-ns'
    )
  )
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Novice'],
    x = ~ForcePeaks[temp_data$User == 'Novice'],
    orientation = "h",
    legendgroup = 'Novice',
    scalegroup = 'Novice',
    name = 'Non-Expert',
    side = 'negative',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("mediumpurple"),
    marker = list(
      line = list(
        width = 1,
        color = "mediumpurple"
      ),
    symbol = 'line-ns'
    )
  )

fig <- fig %>%
  layout(
    title = "Distribution Pattern – Maximum of Peaks in Force Application by Tasks",
    xaxis = list(
      title = "Max of Force Peaks",
      showgrid = T
    ),
    yaxis = list(
      title = "Task Type",
      showgrid = T,
      zeroline = F
    ),
    margin = list(t = 50, b = 10, l = 50, r = 50),
    violingap = 2,
    violingroupgap = 2,
    violinmode = 'overlay'
  )

fig

Force Peak Counts

temp_data <- data.frame("TaskType" = force_seg_info_outlier_removed$TaskType, 
                        "User" = force_seg_info_outlier_removed$User,
                        "PeaksCount" = force_seg_info_outlier_removed$Peaks.Count)

fig <- temp_data %>%
  plot_ly(type = 'violin')
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Expert'],
    x = ~PeaksCount[temp_data$User == 'Expert'],
    orientation = "h",
    legendgroup = 'Expert',
    scalegroup = 'Expert',
    name = 'Expert',
    side = 'positive',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("lightseagreen"),
    marker = list(
      line = list(
        width = 1,
        color = "lightseagreen"
      ),
    symbol = 'line-ns'
    )
  )
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Novice'],
    x = ~PeaksCount[temp_data$User == 'Novice'],
    orientation = "h",
    legendgroup = 'Novice',
    scalegroup = 'Novice',
    name = 'Non-Expert',
    side = 'negative',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("mediumpurple"),
    marker = list(
      line = list(
        width = 1,
        color = "mediumpurple"
      ),
    symbol = 'line-ns'
    )
  )

fig <- fig %>%
  layout(
    title = "Distribution Pattern – Number of Peaks in Force Application by Tasks",
    xaxis = list(
      title = "Number of Force Peaks",
      showgrid = T
    ),
    yaxis = list(
      title = "Task Type",
      showgrid = T,
      zeroline = F
    ),
    margin = list(t = 50, b = 10, l = 50, r = 50),
    violingap = 2,
    violingroupgap = 2,
    violinmode = 'overlay'
  )

fig

Force Signal Flat Spots

temp_data <- data.frame("TaskType" = force_seg_info_outlier_removed$TaskType, 
                        "User" = force_seg_info_outlier_removed$User,
                        "FlatSpots" = force_seg_info_outlier_removed$Flat.Spots)

fig <- temp_data %>%
  plot_ly(type = 'violin')
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Expert'],
    x = ~FlatSpots[temp_data$User == 'Expert'],
    orientation = "h",
    legendgroup = 'Expert',
    scalegroup = 'Expert',
    name = 'Expert',
    side = 'positive',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("lightseagreen"),
    marker = list(
      line = list(
        width = 1,
        color = "lightseagreen"
      ),
    symbol = 'line-ns'
    )
  )
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Novice'],
    x = ~FlatSpots[temp_data$User == 'Novice'],
    orientation = "h",
    legendgroup = 'Novice',
    scalegroup = 'Novice',
    name = 'Non-Expert',
    side = 'negative',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("mediumpurple"),
    marker = list(
      line = list(
        width = 1,
        color = "mediumpurple"
      ),
    symbol = 'line-ns'
    )
  )

fig <- fig %>%
  layout(
    title = "Distribution Pattern – Maximum Run Length in Force Application by Tasks",
    xaxis = list(
      title = "Flat Spots Count",
      showgrid = T
    ),
    yaxis = list(
      title = "Task Type",
      showgrid = T,
      zeroline = F
    ),
    margin = list(t = 50, b = 10, l = 50, r = 50),
    violingap = 2,
    violingroupgap = 2,
    violinmode = 'overlay'
  )

fig

Force Signal Trend

temp_data <- data.frame("TaskType" = force_seg_info_outlier_removed$TaskType, 
                        "User" = force_seg_info_outlier_removed$User,
                        "Trend" = force_seg_info_outlier_removed$Trend)

fig <- temp_data %>%
  plot_ly(type = 'violin')
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Expert'],
    x = ~Trend[temp_data$User == 'Expert'],
    orientation = "h",
    legendgroup = 'Expert',
    scalegroup = 'Expert',
    name = 'Expert',
    side = 'positive',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("lightseagreen"),
    marker = list(
      line = list(
        width = 1,
        color = "lightseagreen"
      ),
    symbol = 'line-ns'
    )
  )
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Novice'],
    x = ~Trend[temp_data$User == 'Novice'],
    orientation = "h",
    legendgroup = 'Novice',
    scalegroup = 'Novice',
    name = 'Non-Expert',
    side = 'negative',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("mediumpurple"),
    marker = list(
      line = list(
        width = 1,
        color = "mediumpurple"
      ),
    symbol = 'line-ns'
    )
  )

fig <- fig %>%
  layout(
    title = "Distribution Pattern – Signal Trend in Force Application by Tasks",
    xaxis = list(
      title = "Trend",
      showgrid = T
    ),
    yaxis = list(
      title = "Task Type",
      showgrid = T,
      zeroline = F
    ),
    margin = list(t = 50, b = 10, l = 50, r = 50),
    violingap = 2,
    violingroupgap = 2,
    violinmode = 'overlay'
  )

fig 

Force Signal Fluctuations

temp_data <- data.frame("TaskType" = force_seg_info_outlier_removed$TaskType, 
                        "User" = force_seg_info_outlier_removed$User,
                        "Fluctuation" = force_seg_info_outlier_removed$Fluctuation)

fig <- temp_data %>%
  plot_ly(type = 'violin')
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Expert'],
    x = ~Fluctuation[temp_data$User == 'Expert'],
    orientation = "h",
    legendgroup = 'Expert',
    scalegroup = 'Expert',
    name = 'Expert',
    side = 'positive',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("lightseagreen"),
    marker = list(
      line = list(
        width = 1,
        color = "lightseagreen"
      ),
    symbol = 'line-ns'
    )
  )
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Novice'],
    x = ~Fluctuation[temp_data$User == 'Novice'],
    orientation = "h",
    legendgroup = 'Novice',
    scalegroup = 'Novice',
    name = 'Non-Expert',
    side = 'negative',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("mediumpurple"),
    marker = list(
      line = list(
        width = 1,
        color = "mediumpurple"
      ),
    symbol = 'line-ns'
    )
  )

fig <- fig %>%
  layout(
    title = "Distribution of Force Signal Fluctuation Index",
    xaxis = list(
      title = "Fluctuation Index",
      showgrid = T
    ),
    yaxis = list(
      title = "Task Type",
      showgrid = T,
      zeroline = F
    ),
    margin = list(t = 50, b = 10, l = 50, r = 50),
    violingap = 2,
    violingroupgap = 2,
    violinmode = 'overlay'
  )

fig

Force Signal Stability

temp_data <- data.frame("TaskType" = force_seg_info_outlier_removed$TaskType, 
                        "User" = force_seg_info_outlier_removed$User,
                        "Stability" = force_seg_info_outlier_removed$Stability)

fig <- temp_data %>%
  plot_ly(type = 'violin')
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Expert'],
    x = ~Stability[temp_data$User == 'Expert'],
    orientation = "h",
    legendgroup = 'Expert',
    scalegroup = 'Expert',
    name = 'Expert',
    side = 'positive',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("lightseagreen"),
    marker = list(
      line = list(
        width = 1,
        color = "lightseagreen"
      ),
    symbol = 'line-ns'
    )
  )
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Novice'],
    x = ~Stability[temp_data$User == 'Novice'],
    orientation = "h",
    legendgroup = 'Novice',
    scalegroup = 'Novice',
    name = 'Non-Expert',
    side = 'negative',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("mediumpurple"),
    marker = list(
      line = list(
        width = 1,
        color = "mediumpurple"
      ),
    symbol = 'line-ns'
    )
  )

fig <- fig %>%
  layout(
    title = "Distribution Pattern – Signal Stability Index in Force Application by Tasks",
    xaxis = list(
      title = "Stability Index",
      showgrid = T
    ),
    yaxis = list(
      title = "Task Type",
      showgrid = T,
      zeroline = F
    ),
    margin = list(t = 50, b = 10, l = 50, r = 50),
    violingap = 2,
    violingroupgap = 2,
    violinmode = 'overlay'
  )

fig

Force Signal Entropy

temp_data <- data.frame("TaskType" = force_seg_info_outlier_removed$TaskType, 
                        "User" = force_seg_info_outlier_removed$User,
                        "Entropy" = force_seg_info_outlier_removed$Entropy)

fig <- temp_data %>%
  plot_ly(type = 'violin')
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Expert'],
    x = ~Entropy[temp_data$User == 'Expert'],
    orientation = "h",
    legendgroup = 'Expert',
    scalegroup = 'Expert',
    name = 'Expert',
    side = 'positive',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("lightseagreen"),
    marker = list(
      line = list(
        width = 1,
        color = "lightseagreen"
      ),
    symbol = 'line-ns'
    )
  )
fig <- fig %>%
  add_trace(
    y = ~TaskType[temp_data$User == 'Novice'],
    x = ~Entropy[temp_data$User == 'Novice'],
    orientation = "h",
    legendgroup = 'Novice',
    scalegroup = 'Novice',
    name = 'Non-Expert',
    side = 'negative',
    points="all",
    cliponaxis = FALSE,
    box = list(
      visible = T
    ),
    meanline = list(
      visible = T
    ),
    color = I("mediumpurple"),
    marker = list(
      line = list(
        width = 1,
        color = "mediumpurple"
      ),
    symbol = 'line-ns'
    )
  )

fig <- fig %>%
  layout(
    title = "Distribution Pattern – Signal Entropy Index in Force Application by Tasks",
    xaxis = list(
      title = "Entropy Index",
      showgrid = T
    ),
    yaxis = list(
      title = "Task Type",
      showgrid = T,
      zeroline = F
    ),
    margin = list(t = 50, b = 10, l = 50, r = 50),
    violingap = 2,
    violingroupgap = 2,
    violinmode = 'overlay'
  )

fig

SmartForceps Dashboard App

A custom-built Dash-Plotly architecture developed in Python environment to construct an interactive web application for visualization and interpretation of data. This platform was interfaced with a progressive web application (PWA) to make it installable on mobile devices.

GO TO THE INTERACTIVE DATA APP:


  1. Project neuroArm, Department of Clinical Neurosciences, University of Calgary.

  2. Project neuroArm, Department of Clinical Neurosciences, University of Calgary.

  3. Binder Dijker Otte (BDO) Canada LLP.

  4. Project neuroArm, Department of Clinical Neurosciences, University of Calgary.

  5. Project neuroArm, Department of Clinical Neurosciences, University of Calgary. Corresponding author. garnette@ucalgary.ca.